Geographical Analysis of media

5. Widgets

Author

Claude Grasland

Objective

The aim of this section is to present the different widgets used for the exploration of hypercubes and developped during the ODYCCEUS project. We adapt a little the initial programs for the case of octocubes that are used in IMAGEUN but the principles remains the same. Each widget will export a dataframe and a plotly figure, making possible to store the results in javascript and/or to use the table for development with another software.

Preparation

Load multilevel octocubes and transform in hypercubes

We load the octocubes at different levels of time agregation and transform them in hypercubes by removing the dual dimensions of states and regions

base<-readRDS("octocubes/hc_mycorpus_covid_states_regions.RDS")
hc_day<-base$day[,.(tag=sum(tags),news=sum(news)),.(who,what,when,states=states1,regions=regions1)]
hc_week<-base$week[,.(tag=sum(tags),news=sum(news)),.(who,what,when,states=states1,regions=regions1)]
hc_month<-base$month[,.(tag=sum(tags),news=sum(news)),.(who,what,when,states=states1,regions=regions1)]
hc_year<-base$year[,.(tag=sum(tags),news=sum(news)),.(who,what,when,states=states1,regions=regions1)]

Load statistical test function

#### ---------------- testchi2 ----------------
#' @title  Compute the average salience of the topic and test significance of deviation
#' @name what
#' @description create a table and graphic of the topic
#' @param tabtest a table with variable trial, success and null.value
#' @param minsamp : Threshold of sample size requested for salience computation
#' @param mintest : Threshold of estimated value requested for chi-square test


testchi2<-function(tabtest=tabtest,
                   minsamp = 20,
                   mintest = 5) 
{
  tab<-tabtest
  n<-dim(tab)[1]
  
  # Compute salience if sample size sufficient (default : N>20)
  tab$estimate <-NA
  tab$salience <-NA
  tab$chi2<-NA
  tab$p.value<-NA
   tab$estimate<-round(tab$success/tab$trial,5)
   tab$salience<-tab$estimate/tab$null.value
  
  # Chi-square test if estimated value sufficient (default : Nij* > 5)
  
  for (i in 1:n) {
    if(tab$trial[i]*tab$null.value[i]>=mintest) {  
      test<-prop.test(x=tab$success[i],n=tab$trial[i], p=tab$null.value[i], 
                      alternative = "greater")
      tab$chi2[i]<-round(test$statistic,2)
      tab$p.value[i]<-round(test$p.value,5)
    } 
  }
 # }
  return(tab)
}

What

Function

### ---------------- what ----------------
#' @title  Compute the average salience of the topic
#' @name what
#' @description create a table and graphic of the topic
#' @param hc an hypercube prepared as data.table
#' @param subtop a subtag of the main tag (default = NA)
#' @param title Title of the graphic


what <- function (hc = hypercube,
                  what = "what",
                  subtop = NA,
                  title = "What ?")
{
 
  
tab<-hc
tab$what<-tab[[what]]
if (is.na(subtop)){tab$what <-tab$what !="_no_"}else {tab$what <- tab$what == subtop}

tab<-tab[,list(news = sum(news)),by = what]
tab$pct<-100*tab$news/sum(tab$news)

p <- plot_ly(tab,
             labels = ~what,
             values = ~pct,
             type = 'pie') %>%
  layout(title = title,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

output<-list("table" = tab, "plotly" =p)

return(output)

}

Application 1 : covid topic

res<-what(hc_year)
res$table
FALSE     what   news       pct
FALSE 1: FALSE 647658 95.425272
FALSE 2:  TRUE  31049  4.574728
res$plotly

Application n°2 : state subtopic

res <-hc_year %>% filter(states != "_no_") %>%
what(what = "states",
     subtop ="RUS",
     title = "Share of Russia in international news")
res$table
FALSE     what       news       pct
FALSE 1: FALSE 142169.665 96.305252
FALSE 2:  TRUE   5454.335  3.694748
res$plotly

Application n°3 : macroregion subtopic

res <-hc_year %>% filter(regions != "_no_") %>%
what(what = "regions",
     subtop ="OR_EU",
     title = "Share of EU in macroregional news")
res$table
FALSE     what      news      pct
FALSE 1:  TRUE  6191.583 32.02598
FALSE 2: FALSE 13141.417 67.97402
res$plotly

Who.What

function

#### ---------------- who.what ----------------
#' @title  visualize variation of the topic between media
#' @name who.what
#' @description create a table of variation of the topic by media
#' @param hc an hypercube prepared as data.table
#' @param test : visualize test (TRUE) or salience (FALSE)
#' @param minsamp : Threshold of sample size requested for salience computation
#' @param mintest sample size of estimate for chi-square test (default = 5)
#' @param title Title of the graphic


who.what <- function (hc = hypercube,
                      what = "what",
                      subtop = NA,
                      test = FALSE,
                      minsamp = 20,
                      mintest = 5,
                      title = "Who says What ?")
{
  
  tab<-hc
  tab$what<-tab[[what]]
if (is.na(subtop)){tab$what <-tab$what !="_no_"}else {tab$what <- tab$what == subtop}
#  {tab$what <-tab$what !="_no_"}
  
  tab<-tab[,list(trial = sum(news),success=round(sum(news*what),0)),by = list(who)]
  ref <-round(sum(tab$success)/sum(tab$trial),4)
  tab$null.value<-ref
  
  tab<-testchi2(tabtest=tab,
                minsamp = minsamp,
                mintest = mintest)
  
  
  
  if (test==FALSE) {tab$index =tab$salience
  tab$index[tab$index>4]<-4
  tab<-tab[tab$trial > minsamp,]
  mycol<-brewer.pal(7,"YlOrRd")
  } 
  else {tab$index=1-tab$p.value
  tab<-tab[tab$trial*tab$null.value>mintest,]
  mycol<-rev(brewer.pal(7,"RdYlBu"))
  mycol[4]<-"lightyellow"
  }
  
  p <- plot_ly(tab,
               x = ~who,
               y = ~estimate*100,
               color= ~index,
               colors= mycol,
               hovertemplate = ~paste('Source: ',who,
                             '<br /> Total news  : ', round(trial,0),
                             '<br /> Topic news : ', round(success,0),
                             '<br /> % observed  : ', round(estimate*100,2),'%',
                             '<br /> % estimated : ', round(null.value*100,2),'%',
                             '<br /> Salience : ', round(salience,2),  
                             '<br /> p.value : ', round(p.value,4)),
               type = "bar")  %>%
    layout(title = title,
           yaxis = list(title = "% news"),
           barmode = 'stack')
  
  output<-list("table" = tab, "plotly" =p)
  
  return(output)
  
}

Applicaton n°1 : Covid Topic

An example of computation of the share of a non spatial topic (Covid) in the full sample of news.

res <- hc_year %>%
who.what(what = "what",
     title = "Share of Covid in total news",
     test=FALSE)

res$table
FALSE           who  trial success null.value estimate  salience    chi2 p.value
FALSE 1: DEU_suddeu 181869    8561     0.0457  0.04707 1.0299781    7.82 0.00258
FALSE 2: FRA_figaro 305544   12869     0.0457  0.04212 0.9216630   89.79 1.00000
FALSE 3: TUN_afrman  53182    4399     0.0457  0.08272 1.8100656 1670.02 0.00000
FALSE 4:  TUR_dunya 138112    5220     0.0457  0.03780 0.8271335  197.69 1.00000
FALSE        index
FALSE 1: 1.0299781
FALSE 2: 0.9216630
FALSE 3: 1.8100656
FALSE 4: 0.8271335
res$plotly

Application n°2 : State subtopic

An example of computation of the share of a national subtopic (Russia) in the sample of news where the topic is present (news with at least one state mentionned).

res <-hc_year %>% filter(states != "_no_") %>%
who.what(what = "states",
     subtop ="RUS",
     title = "Share of Russia in international news",
     test=TRUE)
res$table
FALSE           who trial success null.value estimate  salience   chi2 p.value index
FALSE 1: DEU_suddeu 21301     974      0.037  0.04573 1.2359459  45.27       0     1
FALSE 2: FRA_figaro 77104    2581      0.037  0.03347 0.9045946  26.80       1     0
FALSE 3: TUN_afrman 15816     174      0.037  0.01100 0.2972973 299.30       1     0
FALSE 4:  TUR_dunya 33403    1726      0.037  0.05167 1.3964865 201.40       0     1
res$plotly

Application n°3 : Macroregion subtopic

Same example applied to macroregion : what is the share of the subtopic European Union in the subsample news where at least one macroregion is mentionned.

res <-hc_year %>% filter(regions != "_no_") %>%
who.what(what = "regions",
     subtop ="OR_EU",
     title = "Share of EU in macroregional news",
     test=TRUE)
res$table
FALSE           who trial success null.value estimate  salience   chi2 p.value
FALSE 1: DEU_suddeu  4019    1895     0.3203  0.47151 1.4720887 421.40 0.00000
FALSE 2: FRA_figaro  7455    2092     0.3203  0.28062 0.8761161  53.74 1.00000
FALSE 3: TUN_afrman  1458     453     0.3203  0.31070 0.9700281   0.57 0.77565
FALSE 4:  TUR_dunya  6401    1752     0.3203  0.27371 0.8545426  63.61 1.00000
FALSE      index
FALSE 1: 1.00000
FALSE 2: 0.00000
FALSE 3: 0.22435
FALSE 4: 0.00000
res$plotly

When.What

function

#### ---------------- when.what ----------------
#' @title  visualize variation of the topic through time
#' @name when.what
#' @description create a table of variation of the topic by media
#' @param test : visualize test (TRUE) or salience (FALSE)
#' @param minsamp : Threshold of sample size requested for salience computation
#' @param mintest sample size of estimate for chi-square test (default = 5)
#' @param title Title of the graphic


when.what <- function (hc = hypercube,
                       what = "what",
                       subtop = NA,
                       test = FALSE,
                       minsamp = 20,
                       mintest = 5,
                       title = "When is said What ?")
{
  
  tab<-hc
  tab$what<-tab[[what]]
if (is.na(subtop)){tab$what <-tab$what !="_no_"}else {tab$what <- tab$what == subtop}
#  {tab$what <-tab$what !="_no_"}
  
  tab<-tab[,list(trial = sum(news),success=round(sum(news*what),0)),by = list(when)]
  ref <-round(sum(tab$success)/sum(tab$trial),4)
  tab$null.value<-ref
  
  tab<-testchi2(tabtest=tab,
                minsamp = minsamp,
                mintest = mintest)
  
  if (test==FALSE) {tab$index =tab$salience
  tab<-tab[tab$trial > minsamp,]
  mycol<-brewer.pal(7,"YlOrRd")
  } 
  else {tab$index=tab$p.value
  tab<-tab[tab$trial*tab$null.value>mintest,]
  mycol<-brewer.pal(7,"RdYlBu")
  mycol[4]<-"lightyellow"
  }
  
  
  p <- plot_ly(tab,
               x = ~as.character(when),
               y = ~estimate*100,
               color= ~index,
               colors= mycol,
     #          hoverinfo = "text",
               hovertemplate = ~paste('Time: ',when,
                             '<br /> Total news  : ', round(trial,0),
                             '<br /> Topic news : ', round(success,0),
                             '<br /> % observed  : ', round(estimate*100,2),'%',
                             '<br /> % estimated : ', round(null.value*100,2),'%',
                             '<br /> Salience : ', round(salience,2),  
                             '<br /> p.value : ', round(p.value,4)),
               type = "bar")  %>%
    layout(title = title,
           yaxis = list(title = "% news"),
           barmode = 'stack')
  
  output<-list("table" = tab, "plotly" =p)
  
  return(output)
  
}

Applicaton n°1 : Covid Topic

An example of computation of the share of a non spatial topic (Covid) in the full sample of news by week for one media.

res <- hc_week %>% filter(who=="DEU_suddeu") %>%
when.what(what = "what",
     title = "Share of Covid-19 topic in news published by Süddeutsche Zeitung",
     test=FALSE)

res$table
FALSE            when trial success null.value estimate  salience chi2 p.value
FALSE   1: 2021-09-27   989      30     0.0471  0.03033 0.6439490 5.83 0.99211
FALSE   2: 2021-10-04  1217      57     0.0471  0.04684 0.9944798 0.00 0.50000
FALSE   3: 2021-10-11  1139      54     0.0471  0.04741 1.0065817 0.00 0.50000
FALSE   4: 2021-10-18  1168      50     0.0471  0.04281 0.9089172 0.39 0.73345
FALSE   5: 2021-10-25  1013      47     0.0471  0.04640 0.9851380 0.00 0.51256
FALSE  ---                                                                    
FALSE 257: 2022-11-28   136       5     0.0471  0.03676 0.7804671 0.13 0.64302
FALSE 258: 2022-12-05   167       4     0.0471  0.02395 0.5084926 1.51 0.89053
FALSE 259: 2022-12-12   161       1     0.0471  0.00621 0.1318471 5.12 0.98818
FALSE 260: 2022-12-19    91       5     0.0471  0.05495 1.1666667   NA      NA
FALSE 261: 2022-12-26    86       7     0.0471  0.08140 1.7282378   NA      NA
FALSE          index
FALSE   1: 0.6439490
FALSE   2: 0.9944798
FALSE   3: 1.0065817
FALSE   4: 0.9089172
FALSE   5: 0.9851380
FALSE  ---          
FALSE 257: 0.7804671
FALSE 258: 0.5084926
FALSE 259: 0.1318471
FALSE 260: 1.1666667
FALSE 261: 1.7282378
res$plotly

Application n°2 : State subtopic

Example of analysis of the share of news about Russia among news mentionning one country, by month, for Le Figaro.

res <-hc_month %>% filter(states != "_no_") %>%  filter(who=="FRA_figaro") %>%
when.what(what = "states",
     subtop ="RUS",
     title = "Share of Russia in international news published by Le Figaro",
     test=TRUE)
res$table
FALSE           when trial success null.value estimate  salience   chi2 p.value
FALSE  1: 2021-09-01   735      16     0.0335  0.02177 0.6498507   2.77 0.95205
FALSE  2: 2021-10-01   336       8     0.0335  0.02381 0.7107463   0.70 0.79830
FALSE  3: 2021-11-01   506      14     0.0335  0.02767 0.8259701   0.37 0.72759
FALSE  4: 2021-12-01  1008      43     0.0335  0.04266 1.2734328   2.34 0.06320
FALSE  5: 2022-01-01   330      20     0.0335  0.06061 1.8092537   6.67 0.00489
FALSE  6: 2022-02-01   422      37     0.0335  0.08768 2.6173134  36.60 0.00000
FALSE  7: 2022-03-01   482      92     0.0335  0.19087 5.6976119 363.84 0.00000
FALSE  8: 2022-04-01   399      55     0.0335  0.13784 4.1146269 130.97 0.00000
FALSE  9: 2020-07-01  1054      36     0.0335  0.03416 1.0197015   0.00 0.48696
FALSE 10: 2020-08-01   985      20     0.0335  0.02030 0.6059701   4.90 0.98655
FALSE 11: 2020-09-01  1395      36     0.0335  0.02581 0.7704478   2.32 0.93606
FALSE 12: 2020-10-01  1371      33     0.0335  0.02407 0.7185075   3.48 0.96894
FALSE 13: 2020-11-01  1346      25     0.0335  0.01857 0.5543284   8.81 0.99850
FALSE 14: 2020-12-01  1367      40     0.0335  0.02926 0.8734328   0.63 0.78693
FALSE 15: 2021-01-01  1235      24     0.0335  0.01943 0.5800000   7.12 0.99619
FALSE 16: 2021-02-01  1304      28     0.0335  0.02147 0.6408955   5.46 0.99028
FALSE 17: 2021-03-01  1516      28     0.0335  0.01847 0.5513433  10.12 0.99927
FALSE 18: 2021-04-01  1095      40     0.0335  0.03653 1.0904478   0.22 0.31804
FALSE 19: 2021-05-01  1254      27     0.0335  0.02153 0.6426866   5.18 0.98861
FALSE 20: 2021-06-01  1254      50     0.0335  0.03987 1.1901493   1.38 0.11987
FALSE 21: 2021-07-01  1189      32     0.0335  0.02691 0.8032836   1.40 0.88132
FALSE 22: 2021-08-01   930      26     0.0335  0.02796 0.8346269   0.72 0.80187
FALSE 23: 2022-05-01  1307      80     0.0335  0.06121 1.8271642  30.14 0.00000
FALSE 24: 2022-06-01  1454      79     0.0335  0.05433 1.6217910  18.85 0.00001
FALSE 25: 2022-07-01  1284      65     0.0335  0.05062 1.5110448  11.10 0.00043
FALSE 26: 2018-01-01  1357      28     0.0335  0.02063 0.6158209   6.55 0.99475
FALSE 27: 2018-02-01  1261      46     0.0335  0.03648 1.0889552   0.26 0.30515
FALSE 28: 2018-03-01  1453     104     0.0335  0.07158 2.1367164  63.89 0.00000
FALSE 29: 2018-04-01  1493      66     0.0335  0.04421 1.3197015   4.96 0.01297
FALSE 30: 2018-05-01  1577      51     0.0335  0.03234 0.9653731   0.03 0.57380
FALSE 31: 2018-06-01  1615      47     0.0335  0.02910 0.8686567   0.83 0.81939
FALSE 32: 2018-07-01  1600      50     0.0335  0.03125 0.9328358   0.19 0.66666
FALSE 33: 2018-08-01  1493      40     0.0335  0.02679 0.7997015   1.87 0.91444
FALSE 34: 2018-09-01  1460      33     0.0335  0.02260 0.6746269   5.02 0.98750
FALSE 35: 2018-10-01  1661      36     0.0335  0.02167 0.6468657   6.81 0.99548
FALSE 36: 2018-11-01  1436      45     0.0335  0.03134 0.9355224   0.15 0.64884
FALSE 37: 2018-12-01  1130      26     0.0335  0.02301 0.6868657   3.52 0.96976
FALSE 38: 2019-01-01  1733      52     0.0335  0.03001 0.8958209   0.55 0.77085
FALSE 39: 2019-02-01  1508      30     0.0335  0.01989 0.5937313   8.21 0.99791
FALSE 40: 2019-03-01  1628      28     0.0335  0.01720 0.5134328  12.86 0.99983
FALSE 41: 2019-04-01  1691      36     0.0335  0.02129 0.6355224   7.41 0.99677
FALSE 42: 2019-05-01  1779      43     0.0335  0.02417 0.7214925   4.50 0.98303
FALSE 43: 2019-06-01  1779      64     0.0335  0.03598 1.0740299   0.26 0.30351
FALSE 44: 2019-07-01  1759      52     0.0335  0.02956 0.8823881   0.73 0.80277
FALSE 45: 2019-08-01  1590      66     0.0335  0.04151 1.2391045   2.91 0.04408
FALSE 46: 2019-09-01  2008      57     0.0335  0.02839 0.8474627   1.47 0.88714
FALSE 47: 2019-10-01  1929      39     0.0335  0.02022 0.6035821  10.10 0.99926
FALSE 48: 2019-11-01  1574      47     0.0335  0.02986 0.8913433   0.54 0.76806
FALSE 49: 2019-12-01  1302      44     0.0335  0.03379 1.0086567   0.00 0.50000
FALSE 50: 2020-01-01  1667      24     0.0335  0.01440 0.4298507  18.20 0.99999
FALSE 51: 2020-02-01  1347      30     0.0335  0.02227 0.6647761   4.90 0.98660
FALSE 52: 2020-03-01  1288      19     0.0335  0.01475 0.4402985  13.41 0.99987
FALSE 53: 2020-04-01  1258      21     0.0335  0.01669 0.4982090  10.46 0.99939
FALSE 54: 2020-05-01  1295      42     0.0335  0.03243 0.9680597   0.02 0.55420
FALSE 55: 2020-06-01  1397      28     0.0335  0.02004 0.5982090   7.40 0.99675
FALSE 56: 2022-08-01   968      59     0.0335  0.06095 1.8194030  21.69 0.00000
FALSE 57: 2022-09-01  1322     102     0.0335  0.07716 2.3032836  76.47 0.00000
FALSE 58: 2022-10-01  1198      75     0.0335  0.06260 1.8686567  30.45 0.00000
FALSE 59: 2022-11-01  1037      52     0.0335  0.05014 1.4967164   8.37 0.00191
FALSE 60: 2022-12-01   953      45     0.0335  0.04722 1.4095522   5.12 0.01180
FALSE           when trial success null.value estimate  salience   chi2 p.value
FALSE       index
FALSE  1: 0.95205
FALSE  2: 0.79830
FALSE  3: 0.72759
FALSE  4: 0.06320
FALSE  5: 0.00489
FALSE  6: 0.00000
FALSE  7: 0.00000
FALSE  8: 0.00000
FALSE  9: 0.48696
FALSE 10: 0.98655
FALSE 11: 0.93606
FALSE 12: 0.96894
FALSE 13: 0.99850
FALSE 14: 0.78693
FALSE 15: 0.99619
FALSE 16: 0.99028
FALSE 17: 0.99927
FALSE 18: 0.31804
FALSE 19: 0.98861
FALSE 20: 0.11987
FALSE 21: 0.88132
FALSE 22: 0.80187
FALSE 23: 0.00000
FALSE 24: 0.00001
FALSE 25: 0.00043
FALSE 26: 0.99475
FALSE 27: 0.30515
FALSE 28: 0.00000
FALSE 29: 0.01297
FALSE 30: 0.57380
FALSE 31: 0.81939
FALSE 32: 0.66666
FALSE 33: 0.91444
FALSE 34: 0.98750
FALSE 35: 0.99548
FALSE 36: 0.64884
FALSE 37: 0.96976
FALSE 38: 0.77085
FALSE 39: 0.99791
FALSE 40: 0.99983
FALSE 41: 0.99677
FALSE 42: 0.98303
FALSE 43: 0.30351
FALSE 44: 0.80277
FALSE 45: 0.04408
FALSE 46: 0.88714
FALSE 47: 0.99926
FALSE 48: 0.76806
FALSE 49: 0.50000
FALSE 50: 0.99999
FALSE 51: 0.98660
FALSE 52: 0.99987
FALSE 53: 0.99939
FALSE 54: 0.55420
FALSE 55: 0.99675
FALSE 56: 0.00000
FALSE 57: 0.00000
FALSE 58: 0.00000
FALSE 59: 0.00191
FALSE 60: 0.01180
FALSE       index
res$plotly

Application n°3 : Macroregion subtopic

Example of analysis of the share of news about European news among news mentioning one macroregion, by year, for Dunya.

res <-hc_year %>% filter(regions != "_no_") %>%  filter(who=="TUR_dunya") %>%
when.what(what = "regions",
     subtop ="OR_EU",
     title = "Share of EU in macroregional news published by Dunya",
     test=TRUE)
res$table
FALSE          when trial success null.value estimate  salience  chi2 p.value   index
FALSE 1: 2019-01-01   918     265     0.2737  0.28867 1.0546949  0.96 0.16346 0.16346
FALSE 2: 2020-01-01  1713     422     0.2737  0.24635 0.9000731  6.31 0.99399 0.99399
FALSE 3: 2021-01-01  1448     350     0.2737  0.24171 0.8831202  7.29 0.99654 0.99654
FALSE 4: 2022-01-01  1235     346     0.2737  0.28016 1.0236025  0.23 0.31653 0.31653
FALSE 5: 2018-01-01  1087     369     0.2737  0.33947 1.2402996 23.32 0.00000 0.00000
res$plotly

Where.What

function

#### ---------------- where.what ----------------
#' @title  visualize spatialization of the topic 
#' @name where.what
#' @description create a table of variation of the topic by media
#' @param hc an hypercube prepared as data.table
#' @param test : visualize test (TRUE) or salience (FALSE)
#' @param minsamp : Threshold of sample size requested for salience computation
#' @param mintest sample size of estimate for chi-square test (default = 5)
#' @param map a map with coordinates in lat-long
#' @param proj a projection accepted by plotly
#' @param title Title of the graphic


where.what <- function (hc = hypercube,
                        what = "what",
                        where = "where",
                        subtop = NA,
                        test = FALSE,
                        minsamp = 20,
                        mintest = 5,
                        map = world_ctr,
                        proj = 'azimuthal equal area',
                        title = "Where said What ?")
{
 
  tab<-hc
  tab$what<-tab[[what]]
  tab$where<-tab[[where]]
if (is.na(subtop)){tab$what <-tab$what !="_no_"}else {tab$what <- tab$what == subtop}
#  {tab$what <-tab$what !="_no_"}
  
  tab<-tab[,list(trial = round(sum(news),0),success=round(sum(news*what),0)),by = list(where)]
  ref <-round(sum(tab$success)/sum(tab$trial),4)
  tab$null.value<-ref
  
  tab<-testchi2(tabtest=tab,
                minsamp = minsamp,
                mintest = mintest)
  
  
  
  tab<-tab[order(-chi2),]
  
  
  
  if (test==FALSE) {tab$index =tab$salience
  tab<-tab[tab$trial > minsamp,]
  mycol<-brewer.pal(7,"YlOrRd")
  } else {tab$index=tab$p.value
  tab<-tab[tab$trial*tab$null.value>mintest,]
  mycol<-brewer.pal(7,"RdYlBu")
  mycol[4]<-"lightyellow"
  }
  
  
  map<-merge(map,tab,all.x=T,all.y=F,by.x="ISO3",by.y="where")
  
  
  
  #map2<-map[is.na(map$pct)==F,]
  #map2<-st_centroid(map2)
  #map2<-st_drop_geometry(map2)
  
  
  g <- list(showframe = TRUE,
            framecolor= toRGB("gray20"),
            coastlinecolor = toRGB("gray20"),
            showland = TRUE,
            landcolor = toRGB("gray50"),
            showcountries = TRUE,
            countrycolor = toRGB("white"),
            countrywidth = 0.2,
            projection = list(type = proj))
  
  
  
  p<- plot_geo(map)%>%
    add_markers(x = ~lon,
                y = ~lat,
                sizes = c(0, 250),
                size = ~success,
                #             color= ~signif,
                color = ~index,
                colors= mycol,
#                hoverinfo = "text",
                hovertemplate = ~paste('Location: ',NAME,
                              '<br /> Total news  : ', round(trial,0),
                              '<br /> Topic news : ', round(success,0),
                              '<br /> % observed  : ', round(estimate*100,2),'%',
                              '<br /> % estimated : ', round(null.value*100,2),'%',
                              '<br /> Salience : ', round(salience,2),  
                              '<br /> p.value : ', round(p.value,4))) %>%
    
    layout(geo = g,
           title = title)
  
  
  
  output<-list("table" = tab, "plotly" =p)
  
  return(output)
  
}

Applicaton n°1 : Covid Topic

An example of computation of the share of a non spatial topic (Covid) in the full sample of news by week for one media.

world_ctr<-readRDS("map/world_ctr_4326.Rdata")
res <- hc_week %>% filter(who=="DEU_suddeu") %>% filter(states !="DEU") %>%
where.what(what = "what",
           where ="states",
     title = "Share of Covid-19 topic in foreign news published by Süddeutsche Zeitung",
     test=FALSE)

#res$table
res$plotly

Application n°2.1 : Regional subtopic

Example of analysis of the share of news about EU in news associated to one country

res <-hc_month %>% filter(states != "_no_") %>%  
  filter(who=="FRA_figaro") %>%
  filter(states!="FRA") %>%
where.what(what = "regions",
           subtop = "OR_EU",
           where = "states",
           title = "Countries associated to EU by Le Figaro",
            test=TRUE,
           mintest=2,
           minsamp=10)
#res$table
res$plotly

Application n°2.2 : Regional subtopic

Example of analysis of the share of news about Africa in news associated to one country

res <-hc_month %>% filter(states != "_no_") %>%  
  filter(who=="TUR_dunya") %>%
  filter(states!="TUR") %>%
where.what(what = "regions",
           subtop = "OR_EU",
           where = "states",
           title = "Countries associated to EU by Dunya",
            test=TRUE,
           mintest=1,
           minsamp=5)
#res$table

res$plotly

Application n°2.3 : Regional subtopic

Example of analysis of the share of news about EU in news associated to one country

res <-hc_month %>% filter(states != "_no_") %>%  
  filter(who=="DEU_suddeu") %>%
  filter(states!="DEU") %>%
where.what(what = "regions",
           subtop = "OR_EU",
           where = "states",
           title = "Countries associated to EU by Süd. Zeit.",
            test=TRUE,
           mintest=2,
           minsamp=10)
#res$table
res$plotly

Application n°2.4 : Regional subtopic

Example of analysis of the share of news about Africa in news associated to one country

res <-hc_month %>% filter(states != "_no_") %>%  
  filter(who=="TUN_afrman") %>%
  filter(states!="TUN") %>%
where.what(what = "regions",
           subtop = "OR_EU",
           where = "states",
           title = "Countries associated to EU by African Manager",
            test=TRUE,
           mintest=1,
           minsamp=5)

res$plotly